home *** CD-ROM | disk | FTP | other *** search
/ MACD 5 / MACD 5.bin / workbench / boot / czesc_2 / smsrc / sm / window.pas < prev   
Pascal/Delphi Source File  |  1995-07-11  |  10KB  |  322 lines
  1. Procedure EnableWindow;
  2.  
  3. VAR result : boolean;
  4.  
  5. begin
  6.     (* if (OSV39)
  7.      *  SetWindowPointer(w,TAG_DONE);
  8.     * else
  9.     * not yet, only got v37 defines... NOT!! :) *)
  10.     ClearPointer(w);
  11.     (* Enable window input *)
  12.     EndRequest(req,w);
  13.     (* Enable IDCMP *)
  14.     result := ModifyIDCMP(w,idcmp);
  15. end;
  16.  
  17. Procedure DisableWindow;
  18.  
  19. VAR result : boolean;
  20.  
  21. begin
  22.     result := ModifyIDCMP(w,IDCMP_REFRESHWINDOW);
  23.     (* Block window input *)
  24.     result := Request(req,w);
  25.     (* Set wait pointer *)
  26.      (*if (OSV39)
  27.      *    SetWindowPointer(w,WA_BusyPointer,TRUE,TAG_DONE);
  28.      * else
  29.      * not yet, only got v37 defines *)
  30.     SetPointer(w,WaitPointer,16,16,-6,0);
  31. end;
  32.  
  33. { close the window }
  34. Procedure Close_Window;
  35.  
  36. Begin
  37.     If CD.cd_ScrT = ST_DT then
  38.         CloseDTWin(Window2);
  39.     If CD.cd_ScrT = ST_RAM then
  40.         If Window2 <> NIL then    
  41.             CloseWindow(Window2);
  42.     CloseWindow(TheWindow);       { close window and free gadgets and }
  43.     FreeGadgets(glist);           { visualinfo                        }
  44.     FreeVisualInfo(vi);
  45. End;
  46.  
  47. { Inserts a marker at the first occurence of the given character in the }
  48. { given string. This is then used as the keyboard shortcut for the gadget } 
  49. Function UnderIfThere;
  50.  
  51. VAR
  52.     n        : byte;
  53.     sr       : string;
  54.     Finished : Boolean;
  55.     c        : byte;
  56.     
  57. begin
  58.     c := ToUpper(ord(ch));
  59.     
  60.     if c = 0 then begin
  61.         UnderIfThere := s;
  62.         exit;
  63.     end;
  64.     
  65.     if s[length(s)] = #0 then s := copy(s, 1, length(s)-1);
  66.     finished := False;
  67.     n:=1; 
  68.     
  69.     while not finished AND (n <= length(s)) do begin
  70.         if c = ToUpper(ord(s[n])) then begin
  71.             sr := include('æ', s, n)+#0;
  72.             finished := true;
  73.         end;
  74.         n:=n+1;
  75.     end;
  76.     if not finished then
  77.         sr := s + ' (' + 'æ' + ch + ')' + #0; 
  78.     UnderIfThere := sr;
  79. end;
  80.  
  81. { refresh the window }
  82. Procedure RefreshWin;
  83. begin
  84.     GT_BeginRefresh(TheWindow);
  85.     GT_EndRefresh(TheWindow, True);
  86. end;
  87.  
  88.  
  89.  
  90. { open the window }
  91. Function open_window;
  92.  
  93. CONST
  94.     HSpace = 2{INTERWIDTH}; {2}
  95.     VSpace = 1{INTERHEIGHT}; {1}
  96.  
  97. Var 
  98.     DTags     : Array[0..10] Of tTagItem;
  99.     GTags     : Array[0..1] Of tTagItem;
  100.     tags      : Array[0..5] of tTagItem;
  101.     node      : pMyNode;
  102.     SampTxt   : tIntuiText;
  103.     n,i       : integer;
  104.     sizeofstr : long;
  105.     win       : pWindow;
  106.    
  107. Begin
  108.     win := NIL;
  109.     WindowIDCMP := IDCMP_REFRESHWINDOW | BUTTONIDCMP | IDCMP_CLOSEWINDOW |
  110.                         IDCMP_MOUSEBUTTONS | IDCMP_VANILLAKEY | IDCMP_INTUITICKS;
  111.     glist  := NIL;
  112.  
  113.     { Get visual info and create context }
  114.     vi := GetVisualInfoA(TheScreen, NIL);
  115.     If vi <> NIL Then begin
  116.         pGad := CreateContext(@glist);
  117.         if pgad <> NIL then begin
  118.      
  119.             { Find longest gadget name and determine size }
  120.             node := pMyNode(CurrentList^.lh_Head);
  121.             sizeofstr := 0;
  122.             With SampTxt do begin
  123.                 FrontPen := 0;
  124.                 BackPen := 0;
  125.                 DrawMode := 0;
  126.                 LeftEdge := 0;
  127.                 TopEdge := 0;
  128.                 ITextFont := @CD.cd_Font;
  129.                 IText := @Tmpstr[1];
  130.                 NextText := NIL;
  131.             end;
  132.     
  133.             While pMyNode(node^.LSK_Node.ln_Succ) <> NIL do begin
  134.                 tmpstr := node^.LSK_Name+' (XX)'#0;
  135.                 {$IFDEF DEBUG}
  136.                     {Writeln('Size check, node name : ',tmpstr);}
  137.                 {$ENDIF}
  138.                 If IntuiTextLength(@SampTxt) > sizeofstr then
  139.                     sizeofstr := IntuiTextLength(@SampTxt);
  140.                 node := pMyNode(node^.LSK_Node.ln_Succ);
  141.             end;
  142.  
  143.            Sizes[TBS] := TheScreen^.WBorTop + (TheScreen^.Font^.ta_YSize + 1);
  144.            ZoomS[3] := Sizes[TBS];
  145.            Sizes[GAD_W] := sizeofstr+(2*MyTextFont^.tf_XSize);
  146.            sizes[S_WB_T] := TheScreen^.WBorTop;
  147.            sizes[S_WB_L] := TheScreen^.WBorLeft;
  148.            sizes[S_WB_R] := TheScreen^.WBorRight;
  149.            sizes[S_WB_B] := TheScreen^.WBorBottom;
  150.            
  151.            If CD.cd_ScrT = ST_RAM then begin
  152.                DTags[0].ti_Tag  := WA_Left;
  153.                DTags[0].ti_Data := 0;
  154.                DTags[1].ti_Tag  := WA_Top;
  155.                DTags[1].ti_Data := Sizes[TBS]+1;
  156.                DTags[2].ti_Tag  := WA_Height;
  157.                DTags[2].ti_Data := TheScreen^.Font^.ta_YSize*3;
  158.                DTags[3].ti_Tag  := WA_BackDrop;
  159.                DTags[3].ti_Data := True_; 
  160.                DTags[4].ti_Tag  := WA_Borderless;
  161.                DTags[4].ti_Data := True_;
  162.                DTags[5].ti_Tag  := WA_PubScreen;
  163.                DTags[5].ti_Data := LONG(TheScreen);
  164.                DTags[6].ti_Tag  := WA_IDCMP;
  165.                DTags[6].ti_Data := IDCMP_REFRESHWINDOW;
  166.                DTags[7].ti_Tag  := TAG_END;
  167.                Window2 := OpenWindowTaglist(NIL,@DTags);
  168.                {$IFDEF DEBUG}
  169.                    if Window2 <> NIL then
  170.                         Writeln('Backdrop Window OK');
  171.                 {$ENDIF}
  172.             end else Window2 := NIL;
  173.             
  174.             If CD.cd_ScrT = ST_DT then
  175.                 Window2 := OpenDTWin(CSCPAR( @RememberKey, CD.cd_DT));
  176.    
  177.             { Initilise gadget struncture and tags }
  178.            Tags[0].ti_Tag  := GTTX_Text;
  179.            Tags[0].ti_Data := LONG(NIL);
  180.            Tags[1].ti_Tag  := GTTX_Border;
  181.            Tags[1].ti_Data := True_;
  182.            Tags[2].ti_Tag  := GTTX_CopyText;
  183.            Tags[2].ti_Data := False_;
  184.            Tags[3].ti_Tag  := GTTX_Justification;
  185.            Tags[3].ti_Data := GTJ_CENTER;
  186.            Tags[4].ti_Tag  := GTTX_Clipped;
  187.            Tags[4].ti_Data := True_;
  188.            Tags[5].ti_Tag  := TAG_END;
  189.    
  190.            GTags[0].ti_Tag  := GT_UnderScore;
  191.            GTags[0].ti_Data := LONG('æ');
  192.            GTags[1].ti_Tag  := TAG_END;
  193.  
  194.            With GadgetFlags Do Begin
  195.           ng_TextAttr   := @CD.cd_Font;
  196.           ng_LeftEdge   := sizes[S_WB_L]+HSpace+1;
  197.           ng_Width      := Sizes[GAD_W];
  198.           ng_Height     := Sizes[GAD_H];
  199.           ng_VisualInfo := vi;
  200.           ng_GadgetID   := 0;
  201.            End;
  202.  
  203.             { traverse down list creating gadgets, producing a recessed 
  204.               text display if LSK_Name is 'COMMENT' } 
  205.            node := pMyNode(CurrentList^.lh_Head);
  206.            For n := 1 to CD.cd_Down do begin   
  207.                GadgetFlags.ng_TopEdge    := Sizes[TBS] + VSpace +1 + (n-1)*(Sizes[GAD_H]+VSpace);
  208.                For i := 1 to CD.cd_Across do begin
  209.                     With GadgetFlags Do begin
  210.                       ng_LeftEdge   := sizes[S_WB_L] + (i-1)*(ng_Width+HSpace) + HSpace;
  211.                           
  212.                       If pMyNode(node^.LSK_Node.ln_Succ) <> NIL then begin
  213.                           {$IFDEF DEBUG}
  214.                                    Writeln('Creating Gadget for ',node^.LSK_Name);
  215.                                {$ENDIF}
  216.  
  217.                           IF UpperStr(node^.LSK_Cmd[1]) = 'COMMENT' then begin
  218.                               Tags[0].ti_Data := LONG(CSCPAR( @RememberKey, node^.LSK_Name));
  219.                               ng_GadgetText := NIL;
  220.                               ng_GadgetID   := 0;
  221.                                 pGad := CreateGadgetA(TEXT_KIND, pGad, @Gadgetflags, @Tags);
  222.                             end else begin
  223.                                     if node^.LSK_Key <> '' then 
  224.                                   ng_GadgetText := CSCPAR( @RememberKey, UnderIfThere(node^.LSK_Name, Node^.LSK_Key[1]))
  225.                               else
  226.                                   ng_GadgetText := CSCPAR( @RememberKey, node^.LSK_Name);
  227.                               ng_UserData   := node;
  228.                               ng_GadgetID   := 1;
  229.                               pGad := CreateGadgetA(BUTTON_KIND, pGad, @Gadgetflags, @GTags);
  230.                           end;
  231.                       end else begin  { We dont want to traverse out of the list }
  232.                           Tags[0].ti_Data := LONG(NIL);
  233.                           ng_GadgetText := NIL;
  234.                           ng_GadgetID   := 0;
  235.                             pGad := CreateGadgetA(TEXT_KIND, pGad, @Gadgetflags, @tags);
  236.                       End;
  237.                    End;
  238.                    pGad := CreateGadgetA(BUTTON_KIND, pGad, @Gadgetflags, NIL);
  239.                    If pMyNode(node^.LSK_Node.ln_Succ) <> NIL then
  240.                        node := pMyNode(node^.LSK_Node.ln_Succ);
  241.                end;
  242.            end;
  243.     
  244.             {$IFDEF DEBUG}
  245.                 Writeln('User Gadgets created');
  246.             {$ENDIF}
  247.             { Border around scrolling text, use a TD gadget so we dont have 
  248.               to worry about refreshing a bevelbox }
  249.              if CD.cd_Wit then begin
  250.                 Tags[0].ti_Tag  := GTTX_Text;
  251.                Tags[0].ti_Data := LONG(NIL);
  252.                Tags[1].ti_Tag  := GTTX_Border;
  253.                Tags[1].ti_Data := True_;
  254.                Tags[2].ti_Tag  := TAG_END;
  255.                 With GadgetFlags Do Begin
  256.                      ng_GadgetText := NIL;
  257.                      ng_UserData   := NIL;
  258.                      ng_GadgetID   := 0;
  259.                      ng_TopEdge    := ng_TopEdge + Sizes[TBS] + VSPACE +1;
  260.                      ng_Width      := ng_Width + ng_LeftEdge - sizes[S_WB_L] - 2;
  261.                      ng_LeftEdge   := sizes[S_WB_L] + 2;
  262.                      ng_Height     := CD.cd_SFont.ta_YSize+9;
  263.                end;
  264.                pGad := CreateGadgetA(TEXT_KIND, pGad, @Gadgetflags, @tags);
  265.            end;
  266.  
  267.             {$IFDEF DEBUG}
  268.                 if pgad <> NIL then
  269.                     Writeln('Gadget creation OK');
  270.             {$ENDIF}
  271.             { check nothing went wrong in the gadget production }
  272.            If pGad <> NIL Then begin
  273.    
  274.                Base := (GadgetFlags.ng_TopEdge+GadgetFlags.ng_Height)-5;
  275.    
  276.                 { window tags }
  277.                DTags[0].ti_Tag  := WA_Width;
  278.                DTags[0].ti_Data := GadgetFlags.ng_LeftEdge+GadgetFlags.ng_Width + sizes[S_WB_R] + 2;
  279.                DTags[1].ti_Tag  := WA_Height;
  280.                DTags[1].ti_Data := GadgetFlags.ng_TopEdge+GadgetFlags.ng_Height+3;
  281.                DTags[2].ti_Tag  := WA_Left;
  282.                DTags[2].ti_Data := (TheScreen^.Width div 2) - (DTags[0].ti_Data div 2);
  283.                DTags[3].ti_Tag  := WA_Top;
  284.                DTags[3].ti_Data := Sizes[TBS]+(((TheScreen^.Height-Sizes[TBS]) div 2) - (DTags[1].ti_Data div 2));
  285.                DTags[4].ti_Tag  := WA_IDCMP;
  286.                DTags[4].ti_Data := WindowIDCMP;
  287.                if CD.cd_ScrT = ST_BACK then begin
  288.                    DTags[5].ti_Tag  := WA_Flags;
  289.                    DTags[5].ti_Data := WFLG_BACKDROP|WFLG_BORDERLESS;
  290.                    DTags[6].ti_Tag  := TAG_IGNORE;
  291.                    DTags[6].ti_Data := 0;
  292.                end else begin
  293.                    DTags[5].ti_Tag  := WA_Flags;
  294.                    DTags[5].ti_Data := WFLG_CLOSEGADGET|WFLG_DRAGBAR|WFLG_DEPTHGADGET;
  295.                    DTags[6].ti_Tag  := WA_Title;
  296.                    DTags[6].ti_Data := LONG(CSCPAR( @RememberKey, CD.cd_WinTit)); 
  297.                end;
  298.                DTags[5].ti_Data := DTags[5].ti_Data|WFLG_ACTIVATE|WFLG_SIMPLE_REFRESH|WFLG_RMBTRAP;
  299.                DTags[7].ti_Tag := WA_Gadgets;
  300.                DTags[7].ti_Data:= LONG(gList);
  301.                DTags[8].ti_Tag := WA_CustomScreen;
  302.                DTags[8].ti_Data:= LONG(TheScreen);
  303.                DTags[9].ti_Tag := WA_Zoom;
  304.                DTags[9].ti_Data:= LONG(@ZoomS);
  305.                DTags[10].ti_Tag := TAG_DONE;
  306.  
  307.                 { Open window }
  308.                Win := OpenWindowTaglist(NIL,@DTags);
  309.                If Win <> NIL Then 
  310.                    {$IFDEF DEBUG}
  311.                         Writeln('Main Window OK');
  312.                     {$ENDIF}
  313.                    { Initial refresh of the gadgets }
  314.                    GT_RefreshWindow(Win, NIL);
  315.            end;
  316.        end;
  317.    end;
  318.     Open_Window := win;
  319. End;
  320.  
  321.  
  322.